home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / formset / formset.~pa next >
Text File  |  1996-04-08  |  5KB  |  168 lines
  1. unit Formset;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Tabs;
  8.  
  9. type
  10.  
  11.    TFTOpen  = (ftoSizeBookToPage, ftoSizePageToBook);
  12.    TFTClose = (ftcNeverRelease, ftcAlwaysRelease, ftcMaybeRelease);
  13.  
  14.    TFormTab = class
  15.       Form    : TForm;
  16.       OnOpen  : TFTOpen;
  17.       OnClose : TFTClose;
  18.    end;
  19.  
  20.    TTabLoadEvent = procedure(Sender: TObject;
  21.                              TabIndex: Integer;
  22.                              FormTab: TFormTab) of object;
  23.  
  24.    TFormSet = class(TTabSet)
  25.    private       { Private declarations   }
  26.       FOnClick       : TNotifyEvent;
  27.       FOnChange      : TTabChangeEvent;
  28.       FOnTabLoad     : TTabLoadEvent;
  29.       OldTabIndex    : Integer;
  30.       InternalChange : Boolean;
  31.       ParentHeight   : Integer;
  32.       ParentWidth    : Integer;
  33.       Procedure   TabClose(OldTabIndex: Integer);
  34.       Procedure   TabOpen( NewTabIndex: Integer);
  35.       Function    ConfigureTab(TabIndex: Integer): Boolean;
  36.       constructor Create(aOwner: TComponent); override;
  37.    protected     { Protected declarations }
  38.       procedure Click; override;
  39.    public        { Public declarations    }
  40.  
  41.    published     { Published declarations }
  42.       property  OnClick   : TNotifyEvent    read FOnClick   write FOnClick;
  43.       property  OnChange  : TTabChangeEvent read FOnChange  write FOnChange;
  44.       property  OnTabLoad : TTabLoadEvent   read FOnTabLoad write FOnTabLoad;
  45.    end;
  46.  
  47.  
  48. procedure Register;
  49.  
  50. implementation
  51.  
  52. procedure Register;
  53. begin
  54.    RegisterComponents('Samples', [TFormSet]);
  55. end;
  56.  
  57. constructor TFormSet.Create;
  58. begin
  59.    inherited Create(aOwner);
  60.    OldTabIndex    := TabIndex;
  61.    InternalChange := False;
  62. end;
  63.  
  64. Function TFormSet.ConfigureTab;
  65. var
  66.    FormTab : TFormTab;
  67. begin
  68.    FormTab := Tabs.Objects[TabIndex] as TFormTab;
  69.    if not assigned(FormTab) then
  70.    begin
  71.       FormTab := TFormTab.Create;
  72.       Tabs.Objects[TabIndex] := FormTab;
  73.    end;
  74.    if not assigned(FormTab.Form) then
  75.       if assigned(FOnTabLoad) then
  76.          FOnTabLoad(Self,TabIndex,FormTab);
  77.    Result := assigned(FormTab.Form);
  78. {
  79.    if not Result then
  80.       ShowMessage('Cannot open this tab. No form specified.');
  81. }
  82. end;
  83.  
  84. procedure TFormSet.TabOpen;
  85. var
  86.    FormTab : TFormTab;
  87.    Child   : TForm;
  88. begin
  89.    FormTab := Tabs.Objects[NewTabIndex] as TFormTab;
  90.    Child   := FormTab.Form;
  91.    if ParentHeight   = 0 then ParentHeight   := Parent.ClientHeight;
  92.    if ParentWidth    = 0 then ParentWidth    := Parent.ClientWidth;
  93.    if FormTab.OnOpen = ftoSizePageToBook then
  94.    begin
  95.       Parent.ClientHeight := ParentHeight;
  96.       Parent.ClientWidth  := ParentWidth;
  97.    end;
  98.    if FormTab.OnOpen = ftoSizeBookToPage then
  99.    begin
  100.       Parent.ClientHeight := Child.Height;
  101.       Parent.ClientWidth  := Child.Width;
  102.    end;
  103.    Child.Parent      := Parent;
  104.    Child.Align       := alClient;
  105.    Child.BorderStyle := bsNone;
  106.    Child.Visible     := True;
  107. end;
  108.  
  109. procedure TFormSet.TabClose;
  110. var
  111.    FormTab : TFormTab;
  112. begin
  113.    if OldTabIndex < 0 then exit;
  114.    FormTab := Tabs.Objects[OldTabIndex] as TFormTab;
  115.    if not assigned(FormTab) then
  116.       exit;
  117.    if FormTab.OnClose = ftcAlwaysRelease then
  118.    begin
  119.       FormTab.Form.Release;
  120.       FormTab.Form := Nil;
  121.    end
  122.    else
  123.    begin
  124.       FormTab.Form.Hide;
  125.       FormTab.Form.Parent := Nil;
  126.    end;
  127. end;
  128.  
  129. procedure TFormSet.Click;
  130. var
  131.    AllowChange : Boolean;
  132.    NewTabIndex : Integer;
  133.    FormTab     : TFormTab;
  134. begin
  135.    if InternalChange
  136.    or (TabIndex = OldTabIndex) then
  137.       exit;
  138.    InternalChange := True;               { Prevent too much recursion       }
  139.    NewTabIndex    := TabIndex;           { Temporarily undo TabIndex change }
  140.    TabIndex       := OldTabIndex;
  141.  
  142.    AllowChange    := True;
  143.    if OldTabIndex >= 0 then
  144.    begin
  145.       FormTab := Tabs.Objects[OldTabIndex] as TFormTab;
  146.       if assigned(FormTab.Form) then
  147.          AllowChange := FormTab.Form.CloseQuery;
  148.    end;
  149.    If AllowChange then
  150.       AllowChange := ConfigureTab(NewTabIndex);
  151.    if AllowChange then
  152.       if assigned(FOnChange) then
  153.          fOnChange(Self,NewTabIndex,AllowChange);
  154.    if AllowChange then
  155.    begin
  156.       TabClose(OldTabIndex);
  157.       TabOpen(NewTabIndex);
  158.       TabIndex    := NewTabIndex;
  159.       OldTabIndex := NewTabIndex;
  160.       if assigned(FOnClick) then
  161.          OnClick(Self);
  162.    end;
  163.    InternalChange := False;
  164. end;
  165.  
  166. Initialization
  167. end.
  168.